MacTech 1 to 12/MacTech-vol-1-12.toast/Source/MacTech® Magazine/Volume 05 - 1989/05.06 Jun 89/LOC Source/Test Source/Test.p

Text File | 1988-07-27 | 10.7 KB | 504 lines | [TEXT/MPS ]

(*****************************************************
Test.p
    List-of-Controls example, using pop-up menu
    controls.
*****************************************************)

PROGRAM Test;

USES
    {$U MemTypes.p                }    MemTypes,
    {$U QuickDraw.p               }    QuickDraw,
    {$U OSIntf.p                      }    OSIntf,
    {$U ToolIntf.p                    }    ToolIntf,
    {$U PackIntf.p                    }    PackIntf,
    {$U PopMenuIntf.p            }    PopMenuIntf;

CONST
    RES_ID        = 128;        { resource ID's    }

    iOK                =    1;            { OK button            }
    iLIST                =    2;            { list of controls    }

    { visibility }
    isVIS                = 255;
    notVIS            =   0;

TYPE
    { Pascal equivalent of 'INT#' resource type }
    IntList = record
        count:        INTEGER;
        int:                array[1..1024] of INTEGER;
    end;  { IntList }

    ILPointer = ^IntList;
    ILHandle = ^ILPointer;


VAR
    myDialog:    DialogPtr;    { test dialog            }
    lh:                    ListHandle;    { handle to list        }
    itemHit:        INTEGER;    { user's choice        }
    savePort:    GrafPtr;        { to save port in        }





(*****************************************************
CenterWindow:    Centers the given window in the
    screen.  If the 'show' argument is TRUE, then the
    window is shown.
*****************************************************)

PROCEDURE CenterWindow(wPtr: WindowPtr;
                                                        show: Boolean);
VAR
    pRect:        Rect;
    wRect:        Rect;
    h, v:        INTEGER;

BEGIN
    pRect := screenBits.bounds;
    wRect := WindowPeek(wPtr)^.port.portRect;

    v := ((pRect.bottom - pRect.top) -
            (wRect.bottom - wRect.top)) div 3;
    h := ((pRect.right - pRect.left) -
            (wRect.right - wRect.left)) div 2;

    MoveWindow(wPtr, h, v, show);

    if (show) then begin
        ShowWindow(wPtr);
    end;
END;  { CenterWindow }



(*****************************************************
FixCtlRects:  Make the contrlRects of all controls in
    the list match their list rectangles, and that controls
    in invisible cells are also invisible.
*****************************************************)

PROCEDURE FixCtlRects(lh: ListHandle);
VAR
    ch:                ControlHandle;
    i:                    INTEGER;
    dl:                INTEGER;
    toRect:        Rect;
    c:                Cell;

BEGIN
    { default }
    dl := sizeof(Handle);

    { update the controls in the list }
    FOR i := 0 to (lh^^.dataBounds.bottom - 1) DO BEGIN
        { define cell to access }
        SetPt(Point(c), 0, i);

        { get the control handle from the cell }
        LGetCell(@ch, dl, c, lh);

        IF (PtInRect(Point(c), lh^^.visible)) THEN
            BEGIN
                { get cell rect; copy into control rect }
                LRect(toRect, c, lh);
                ch^^.contrlRect := toRect;

                { make sure the control is visible }
                ch^^.contrlVis := isVIS;
            END
        ELSE BEGIN
            { make sure the control is invisible }
            ch^^.contrlVis := notVIS;
        END;
    END;
END;  { FixCtlRects }




(*****************************************************
FindCell:  Find the cell in the given list containing
    the given point, which is assumed to be in local
    coördinates.  If the point is not in the list's
    rectangle, the resulting cell will have both
    h and v set to (-1).
*****************************************************)

FUNCTION FindCell(p: Point; lh: ListHandle): Cell;
VAR
    c:     Cell;

BEGIN
    with lh^^ do begin
        if (not PtInRect(p, rView)) then
            SetPt(Point(c), -1, -1)
        else with rView.topLeft do begin
            c.h := ((p.h - h) DIV cellSize.h) + visible.left;
            c.v := ((p.v - v) DIV cellSize.v) + visible.top;
        end;  { else, with rView.topLeft }
    end;  { with lh^^ }

    FindCell := c;
END;  { FindCell }




(*****************************************************
doKeyDown:  Filters all keyDown events in the modal
    dialog, implementing the standard keyboard
    equivalents for the OK button.
*****************************************************)

FUNCTION doKeyDown(dPtr: DialogPtr;
                   VAR theEvent:  EventRecord;
                   VAR itemHit: INTEGER): Boolean;
VAR
    c:        LONGINT;

BEGIN
    { default }
    doKeyDown := FALSE;

    { get the ascii code }
    c := BitAnd(theEvent.message, charCodeMask);

    { check for Return or Enter }
    IF ((c = 3) or ( c = 13)) THEN BEGIN
        itemHit := iOK;
        doKeyDown := TRUE;
    END;  { if }
END;  { doKeyDown }




(*****************************************************
doMouseDown
*****************************************************)

FUNCTION doMouseDown(dPtr: DialogPtr;
                     VAR theEvent:  EventRecord;
                     VAR itemHit: INTEGER): Boolean;
VAR
    item:    INTEGER;
    part:    INTEGER;
    pt:        Point;
    c:        Cell;
    ch:        ControlHandle;
    dbl:    Boolean;
    sel:    Boolean;

BEGIN
    pt := theEvent.where;
    GlobalToLocal(pt);

    { See Tech Note #112, FindDItem() }
    item := FindDItem(dPtr, pt) + 1;

    IF (item = iLIST) THEN
        BEGIN
            { in whom did the mouseDown occur? }
            part := FindControl(pt, dPtr, ch);

            IF ((ch = nil) or (ch = lh^^.vScroll)) THEN
                BEGIN
                    { clicked in list or in scroll bar }
                    dbl := LClick(pt, theEvent.modifiers, lh);

                    { fix the controls' contrlRects }
                    FixCtlRects(lh);
                END
            ELSE BEGIN { clicked in pop-up menu }
                part := TrackControl(ch, pt, POINTER(-1));

                { what cell was the mouseDown in? }
                c := FindCell(pt, lh);

                { redraw the control if cell was selected }
                if (LGetSelect(false, c, lh)) then begin
                    HiliteControl(ch, titlePart);
                end;  { if }
            END;  { else }

            doMouseDown := TRUE;
        END  { item = iLIST }
    ELSE BEGIN
        doMouseDown := FALSE;
    END;
END;  { doMouseDown }




(*****************************************************
doUpdateEvt
*****************************************************)

FUNCTION doUpdateEvt(dPtr: DialogPtr;
                   VAR theEvent:  EventRecord;
                   VAR itemHit: INTEGER): Boolean;
BEGIN
    { begin the update }
    BeginUpdate(dPtr);

    { update the dialog items }
    UpdtDialog(dPtr, dPtr^.visRgn);

    { update the list }
    LUpdate(dPtr^.visRgn, lh);

    { end the update }
    EndUpdate(dPtr);

    { always return true (we handled it) }
    doUpdateEvt := TRUE;
END;  { doUpdateEvt }




(*****************************************************
MyFilter
*****************************************************)

FUNCTION MyFilter(dPtr: DialogPtr;
                  VAR theEvent:  EventRecord;
                  VAR itemHit: INTEGER): Boolean;
BEGIN
    CASE theEvent.what OF
        keyDown:
            MyFilter := doKeyDown(dPtr, theEvent, itemHit);
        mouseDown:
            MyFilter := doMouseDown(dPtr, theEvent, itemHit);
        updateEvt:
            MyFilter := doUpdateEvt(dPtr, theEvent, itemHit);
        OTHERWISE
            MyFilter := FALSE;
    END;  { case }
END;  { MyFilter }





(*****************************************************
DrawUserItems
*****************************************************)

PROCEDURE DrawUserItems(wPtr: WindowPtr;
                itemNo: INTEGER);
VAR
    savePen:        PenState;
    ik:                INTEGER;
    ih:                Handle;
    ib:                Rect;

BEGIN    { DrawUserItems }
    { save, naormalize the pen state }
    GetPenState(savePen);
    PenNormal;

    { frame the list }
    GetDItem(wPtr, iLIST, ik, ih, ib);
    FrameRect(ib);

    { frame the default button }
    GetDItem(wPtr, iOK, ik, ih, ib);
    InsetRect(ib, -4, -4);
    PenSize(3, 3);
    FrameRoundRect(ib, 16, 16);

    { restore the pen's state }
    SetPenState(savePen);
END;    { DrawUserItems }




(*****************************************************
ReadData: Reads in a number of controls, as specified
    by a 'INT#' integer-array resource.  Defines new
    controls for each.
*****************************************************)

FUNCTION ReadData(dPtr: DialogPtr): Boolean;
VAR
    ch:                ControlHandle;
    iah:            ILHandle;
    i:                INTEGER;
    n:                INTEGER;
    ignore:            INTEGER;
    aCell:            Cell;
    p:                Point;
    aRect:            Rect;

BEGIN    { ReadData }
    { get handle to 'INT#' resource }
    iah := ILHandle(GetResource('INT#', RES_ID));

    IF (iah <> nil) THEN BEGIN
        { disable list drawing }
        LDoDraw(false, lh);

        FOR i := 1 TO iah^^.count DO BEGIN
            { create a new control  }
            ch := GetNewControl(iah^^.int[i], dPtr);

            IF (ch = nil) THEN LEAVE;

            { make the control visible, without drawing }
            ch^^.contrlVis := 255;

            ignore := LAddRow(1, 32767, lh);
            SetPt(Point(aCell), 0, i - 1);
            LSetCell(@ch, sizeof(Handle), aCell, lh);
        END;  { for }

        { fix the controls' contrlRects }
        FixCtlRects(lh);

        { select first control }
        SetPt(Point(aCell), 0, 0);
        LSetSelect(true, aCell, lh);

        { enable list drawing }
        LDoDraw(true, lh);
    END;  { iah <> nil }

    { return TRUE if controls were read iOK }
    ReadData := (iah <> nil);
END;  { ReadData }




(*****************************************************
InitList:  Define and allocate new list, into which
    will be placed a number of control handles.
    (See ReadData(), above.)
*****************************************************)
PROCEDURE InitList(dPtr: DialogPtr);
VAR
    ik:            INTEGER;
    ih:            Handle;
    ib:            Rect;
    dBounds:    Rect;
    cSize:        Point;

BEGIN
    { set up the userItem drawing routine }
    GetDItem(dPtr, iLIST, ik, ih, ib);
    SetDItem(dPtr, iLIST, ik, Handle(@DrawUserItems), ib);

    { inset rect, for drawing; leave room for scroll bar }
    InsetRect(ib, 1, 1);
    ib.right := ib.right - 15;

    { allocate space for a single column, no rows }
    SetRect(dBounds, 0, 0, 1, 0);

    { indicate cell size }
    SetPt(cSize, ib.right-ib.left, 20);

    { create the list }
    lh := LNew(
                                ib,          { rView        }
                                dBounds,  { dataBounds    }
                                cSize,      { cell size    }
                                RES_ID,   { resource ID    }
                                dPtr,      { this window    }
                                false,      { draw it        }
                                false,      { grow box    }
                                false,      { sBar, horiz    }
                                true);      { sBar, vert    }
END;  { InitList }




(*****************************************************
CleanUp:  My name is CleanUp().  You killed my dialog.
    Prepare to die!
*****************************************************)

PROCEDURE CleanUp(dPtr: DialogPtr);
VAR
    ch:        ControlHandle;
    i:        INTEGER;
    dl:        INTEGER;
    c:        Cell;

BEGIN
    { default }
    dl := sizeof(Handle);

    { indicate wait }
    SetCursor(GetCursor(watchCursor)^^);

    { deallocate the controls from the list }
    FOR i := 0 to (lh^^.dataBounds.bottom - 1) DO BEGIN
        SetPt(Point(c), 0, i);
        LGetCell(@ch, dl, c, lh);

        DisposeControl(ch);
    END;  { for }

    { dispose of the list }
    LDispose(lh);

    { dispose of the dialog }
    DisposDialog(dPtr);
END;  { CleanUp }





(*****************************************************
Main
*****************************************************)

BEGIN
    { perform the ritual incantation }
    InitGraf(@thePort);
    InitFonts;
    FlushEvents(everyEvent, 0);
    InitWindows;
    InitMenus;
    TEInit;
    InitDialogs(NIL);
    InitCursor;

    { read in the dialog from its resource template }
    myDialog := GetNewDialog(RES_ID, NIL,
                                POINTER(-1));

    { create and init the list of controls }
    InitList(myDialog);

    IF (ReadData(myDialog)) THEN BEGIN
        { center and show the dialog }
        CenterWindow(myDialog, true);

        { save grafPort, make ours current }
        GetPort(savePort);
        SetPort(myDialog);

        { cycle through ModalDialog() }
        REPEAT
            ModalDialog(@MyFilter, itemHit);
        UNTIL itemHit = iOK;

        { restore grafPort }
        SetPort(savePort);
    END;

    { dispose of the dialog's storage }
    CleanUp(myDialog);
END.  { FILE Test.p, PROGRAM Test.p }